home *** CD-ROM | disk | FTP | other *** search
/ BMUG PD-ROM A / PD-ROM A.iso / Utility / Text / UUTool / uu engine / uuencode⁄p / encode.p < prev   
Encoding:
Text File  |  1991-06-15  |  2.1 KB  |  98 lines  |  [TEXT/PJMM]
  1. {* }
  2. {    REAL Simple UENG Sample App}
  3. {    Written by Leonard Rosenthol}
  4. {    Original Version  - 06/01/91}
  5. {    Pascal Conversion - 06/11/91}
  6. {    Don't forget to copy the uu**code resource over and rename it}
  7. {    encode.π.rsrc.}
  8. {*}
  9.  
  10. PROGRAM Encode;
  11.  
  12.     USES
  13.         UUIntf;
  14.  
  15.     VAR
  16.         origFile, destFile: SFReply;
  17.         err: OSErr;
  18.         origName: Str255;
  19.  
  20.  
  21.  
  22.     PROCEDURE InitToolbox;
  23.     BEGIN
  24.         InitGraf(@thePort);
  25.         InitCursor;
  26.         InitFonts;
  27.         InitWindows;
  28.         InitMenus;
  29.         InitDialogs(NIL);
  30.         TEInit;
  31.         FlushEvents(-1, 0);
  32.     END;
  33.  
  34.  
  35.     PROCEDURE getOrigFile (VAR reply: SFReply);
  36.         VAR
  37.             where: Point;
  38.             typeList: SFTypeList;
  39.     BEGIN
  40.         SetPt(where, 50, 50);
  41.         typeList[0] := 'TEXT';
  42.         SFGetFile(where, '', NIL, 1, typeList, NIL, reply);
  43.     END;
  44.  
  45.     PROCEDURE getDestFile (VAR reply: SFReply; VAR destName: Str255);
  46.         VAR
  47.             where: Point;
  48.     BEGIN
  49.         SetPt(where, 50, 50);
  50.         SFPutFile(where, 'Name the encoded file', destName, NIL, reply);
  51.     END;
  52.  
  53.     FUNCTION encodeFiles (origFile, destFile: SFReply): OSErr;
  54.         VAR
  55.             engineHdl, tableHdl: Handle;
  56.             err, err1: OSErr;
  57.             origRefNum, destRefNum, numbufrs: integer;
  58.             header: Str255;
  59.             count: longint;
  60.     BEGIN
  61.         numbufrs := 100;
  62.         err := FSOpen(origFile.fName, origFile.vRefNum, origRefNum);
  63.         IF (err = noErr) THEN
  64.         BEGIN
  65.             err := Create(destFile.fName, destFile.vRefNum, 'MPS ', 'TEXT');
  66.             IF (err = noErr) THEN
  67.             BEGIN
  68.                 err := FSOpen(destFile.fName, destFile.vRefNum, destRefNum);
  69.                 header := CONCAT('begin 0755 ', origFile.fName, CHR(13));
  70.                 count := length(header);
  71.                 err := FSWrite(destRefNum, count, @header[1]);
  72.  
  73.                 err := UULoad(tableHdl, engineHdl);
  74.                 err := uuencode(origRefNum, destRefNum, numbufrs, NIL, tableHdl^, engineHdl^);
  75.                 UUnload(tableHdl, engineHdl);
  76.  
  77.                 header := CONCAT('end', CHR(13));
  78.                 count := length(header);
  79.                 err := FSWrite(destRefNum, count, @header[1]);
  80.                 err1 := FSClose(destRefNum);
  81.             END;
  82.             err1 := FSClose(origRefNum);
  83.         END;
  84.         encodeFiles := err;
  85.     END;
  86.  
  87.  
  88. BEGIN
  89.     InitToolbox;
  90.     getOrigFile(origFile);
  91.     IF (origFile.good) THEN
  92.     BEGIN
  93.         origName := CONCAT(origFile.fName, '.uu');
  94.         getDestFile(destFile, origName);
  95.         IF (destFile.good) THEN
  96.             err := encodeFiles(origFile, destFile);
  97.     END;
  98. END.